home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / FileCache.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  1.6 KB  |  77 lines
  1. package FileCache;
  2.  
  3. =head1 NAME
  4.  
  5. FileCache - keep more files open than the system permits
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     cacheout $path;
  10.     print $path @data;
  11.  
  12. =head1 DESCRIPTION
  13.  
  14. The C<cacheout> function will make sure that there's a filehandle open
  15. for writing available as the pathname you give it.  It automatically
  16. closes and re-opens files if you exceed your system file descriptor
  17. maximum.
  18.  
  19. =head1 BUGS
  20.  
  21. F<sys/param.h> lies with its C<NOFILE> define on some systems,
  22. so you may have to set $cacheout::maxopen yourself.
  23.  
  24. =cut
  25.  
  26. require 5.000;
  27. use Carp;
  28. use Exporter;
  29.  
  30. @ISA = qw(Exporter);
  31. @EXPORT = qw(
  32.     cacheout
  33. );
  34.  
  35.  
  36. sub cacheout_open {
  37.     my $pack = caller(1);
  38.     open(*{$pack . '::' . $_[0]}, $_[1]);
  39. }
  40.  
  41. sub cacheout_close {
  42.     my $pack = caller(1);
  43.     close(*{$pack . '::' . $_[0]});
  44. }
  45.  
  46.  
  47. $cacheout_seq = 0;
  48. $cacheout_numopen = 0;
  49.  
  50. sub cacheout {
  51.     ($file) = @_;
  52.     unless (defined $cacheout_maxopen) {
  53.     if (open(PARAM,'/usr/include/sys/param.h')) {
  54.         local ($_, $.);
  55.         while (<PARAM>) {
  56.         $cacheout_maxopen = $1 - 4
  57.             if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
  58.         }
  59.         close PARAM;
  60.     }
  61.     $cacheout_maxopen = 16 unless $cacheout_maxopen;
  62.     }
  63.     if (!$isopen{$file}) {
  64.     if (++$cacheout_numopen > $cacheout_maxopen) {
  65.         my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
  66.         splice(@lru, $cacheout_maxopen / 3);
  67.         $cacheout_numopen -= @lru;
  68.         for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
  69.     }
  70.     cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
  71.         or croak("Can't create $file: $!");
  72.     }
  73.     $isopen{$file} = ++$cacheout_seq;
  74. }
  75.  
  76. 1;
  77.